module PrettyJSON(renderJValue) where

import Char
import Data.Bits
import Numeric
import Prettify
import SimpleJSON

renderJValue (JString str) = string str
renderJValue (JNumber num) = text (show num)
renderJValue (JBool True) = text "true"
renderJValue (JBool False) = text "false"
renderJValue JNull = text "null"
renderJValue (JObject obj) = series '{' '}' field obj
    where field (name, val) = string name <> text ": " <> renderJValue val
renderJValue (JArray ary) = series '[' ']' renderJValue ary

enclose left right x = char left <> x <> char right

series open close transform =
    enclose open close . fsep . punctuate (char ',') . map transform

punctuate p [] = []
punctuate p [d] = [d]
punctuate p (d:ds) = (d <> p) : punctuate p ds

string = enclose '"' '"' . hcat . map oneChar

oneChar c = case lookup c simpleEscapes of
              Just r -> text r
              Nothing | mustEscape c -> hexEscape c
                      | otherwise -> char c
    where mustEscape c = c < ' ' || c == '\x7f' || c > '\xff'

simpleEscapes = zipWith ch "\b\n\f\r\t\\\"/" "bnfrt\\\"/"
    where ch a b = (a, ['\\', b])

smallHex x = text "\\u"
             <> text (replicate (4 - length h) '0')
             <> text h
    where h = showHex x ""

astral n = smallHex (a + 0xd800) <> smallHex (b + 0xdc00)
    where a = (n `shiftR` 10) .&. 0x3ff
          b = n .&. 0x3ff

hexEscape c | d < 0x10000 = smallHex d
            | otherwise = astral (d - 0x10000)
    where d = ord c
